
# helper functions to generate formatted outputs: 
# see http://sqlselect.googlecode.com/ 

clean.markup <- function(x ) 
	gsub(">", "&gt;", gsub("<", "lt;", gsub("&", "&amp;", format(x, digits=4 ) ) ) ) 

sql.select.htmltable <- function(query, ... ) {
	# invoke sql.select and collect the resulting table as HTML (using a tabular grayscale layout). 
	td.format <- function(x) sprintf("<td style='border-style:none;'>%s</td>", clean.markup(x ) )
	tr.format <- function(x, style ) sprintf("<tr style='%s'>%s</tr>", style, x )
	cells <- sapply(sql.select(query, ... ), td.format )
	columns <- sapply(dimnames(cells)[[2]], td.format ) 
	html <- "<table><tbody>" 
	html <- paste(html, tr.format(paste(as.vector(columns), collapse=" " ), 
		"background-color:#444444; font-weight:bold; color:white;" ) )
	for (i in 1:nrow(cells) ) 
		html <- paste(html, tr.format(paste(as.vector(cells[i,] ), collapse=" " ), 
			sprintf("background-color:%s",  if (i%%2) "#EEEEEE" else "#DDDDDD" ) ) ) 
	return(paste(html, "</tbody><table>" ) )
}

sql.select.htmlsyntax <- function(query, ... ) {
	# highlight the syntax of a parsed query using HTML. 
	tokenlist <- sql.select(query, fetch.tokenlist=TRUE, ... ) 
	tokenlist$token.values <- clean.markup(tokenlist$token.values ) 
	styles <- list(
		"ws" = "background-color: #EEE ", 
		"comment" = "color: #444; font-style:italic;", 
		"rexpression" = "color: #41A; font-weight:bold; ", 
		"ridentifier" = "color: #62C; text-decoration:underline; "
	)
	default.style <- "font-weight: bold; " # all other (keywords)
	tokenstyles <- as.character(ifelse(tokenlist$tokens %in% names(styles), 
		styles[tokenlist$tokens], default.style ) ) 
	contents <- paste(sprintf("<span style='%s'>%s</span>", 
		tokenstyles, gsub("\n", "<br/>", tokenlist$token.values ) ), collapse=" " ) 
	divstyle <- paste("font-family: monospace; border-width:2px; ",
		"border-style:solid; border-color:black; ", 
		"padding: 12px; background-color: #F7F7F7; margin: 24px; " )
	return(sprintf("<div style='%s'>%s</div>", divstyle, contents ) ) 
}

sql.select.plaintable <- function(query, ... ) {
	# invoke sql.select and collect the resulting table as a minimalistic HTML syntax. 
	resultset <- sql.select(query, ... )
	tr.format <- function(rowcells, fontcolor ) 
		sprintf("<tr>%s</tr>", 
			paste('<td><font color="',fontcolor,'">',clean.markup(rowcells),'</font></td>', 
			sep="", collapse=" \n " ) ) 
	columnheaders <- paste("<td><b>",names(resultset ),"</b></td>", sep='', collapse=' ' )
	html <- paste('<table border="1" cellpadding="3" cellspacing="0"><tbody>
		   <thead><tr>',columnheaders,'</tr></thead>', sep='' )
	for (i in 1:nrow(resultset) ) 
		html <- paste(html, tr.format(resultset[i,], if (i%%2) "#999999" else "#2222222" ) ) 
	return(paste(html, "</tbody><table>" ) )
}

